home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / ldb / purify.c < prev    next >
C/C++ Source or Header  |  1992-02-24  |  22KB  |  763 lines
  1. /* Purify. */
  2.  
  3. /* $Header: purify.c,v 1.16 92/01/25 14:39:55 wlott Exp $ */
  4.  
  5. #include <stdio.h>
  6.  
  7. #include "lisp.h"
  8. #include "ldb.h"
  9. #include "os.h"
  10. #include "globals.h"
  11. #include "validate.h"
  12. #include "interrupt.h"
  13. #include "gc.h"
  14.  
  15. /* These hold the original end of the read_only and static spaces so we can */
  16. /* tell what are forwarding pointers. */
  17.  
  18. static lispobj *read_only_end, *static_end;
  19.  
  20. static lispobj *read_only_free, *static_free;
  21. static lispobj *pscav();
  22.  
  23. #define LATERBLOCKSIZE 1020
  24. #define LATERMAXCOUNT 10
  25.  
  26. static struct later {
  27.     struct later *next;
  28.     union {
  29.         lispobj *ptr;
  30.         int count;
  31.     } u[LATERBLOCKSIZE];
  32. } *later_blocks = NULL;
  33. static int later_count = 0;
  34.  
  35.  
  36. #define NWORDS(x,y) (CEILING((x),(y)) / (y))
  37.  
  38. #ifdef sparc
  39. #define RAW_ADDR_OFFSET 0
  40. #else
  41. #define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer)
  42. #endif
  43.  
  44. static boolean forwarding_pointer_p(obj)
  45.      lispobj obj;
  46. {
  47.     lispobj *ptr;
  48.  
  49.     ptr = (lispobj *)obj;
  50.  
  51.     return ((static_end <= ptr && ptr <= static_free) ||
  52.             (read_only_end <= ptr && ptr <= read_only_free));
  53. }
  54.  
  55. static boolean dynamic_pointer_p(ptr)
  56.      lispobj ptr;
  57. {
  58.     return ptr >= (lispobj)dynamic_0_space;
  59. }
  60.  
  61. static void pscav_later(where, count)
  62.      lispobj *where;
  63.      int count;
  64. {
  65.     struct later *new;
  66.  
  67.     if (count > LATERMAXCOUNT) {
  68.         while (count > LATERMAXCOUNT) {
  69.             pscav_later(where, LATERMAXCOUNT);
  70.             count -= LATERMAXCOUNT;
  71.             where += LATERMAXCOUNT;
  72.         }
  73.     }
  74.     else {
  75.         if (later_blocks == NULL || later_count == LATERBLOCKSIZE ||
  76.             (later_count == LATERBLOCKSIZE-1 && count > 1)) {
  77.             new  = (struct later *)malloc(sizeof(struct later));
  78.             new->next = later_blocks;
  79.             if (later_blocks && later_count < LATERBLOCKSIZE)
  80.                 later_blocks->u[later_count].ptr = NULL;
  81.             later_blocks = new;
  82.             later_count = 0;
  83.         }
  84.  
  85.         if (count != 1)
  86.             later_blocks->u[later_count++].count = count;
  87.         later_blocks->u[later_count++].ptr = where;
  88.     }
  89. }
  90.  
  91. static lispobj ptrans_boxed(thing, header, constant)
  92.      lispobj thing, header;
  93.      boolean constant;
  94. {
  95.     int nwords;
  96.     lispobj result, *new, *old;
  97.  
  98.     nwords = 1 + HeaderValue(header);
  99.  
  100.     /* Allocate it */
  101.     old = (lispobj *)PTR(thing);
  102.     if (constant) {
  103.         new = read_only_free;
  104.         read_only_free += CEILING(nwords, 2);
  105.     }
  106.     else {
  107.         new = static_free;
  108.         static_free += CEILING(nwords, 2);
  109.     }
  110.  
  111.     /* Copy it. */
  112.     bcopy(old, new, nwords * sizeof(lispobj));
  113.  
  114.     /* Deposit forwarding pointer. */
  115.     result = (lispobj)new | LowtagOf(thing);
  116.     *old = result;
  117.         
  118.     /* Scavenge it. */
  119.     pscav(new, nwords, constant);
  120.  
  121.     return result;
  122. }
  123.  
  124. static lispobj ptrans_symbol(thing, header)
  125. {
  126.     int nwords;
  127.     lispobj result, *new, *old, oldfn;
  128.     struct symbol *sym;
  129.  
  130.     nwords = 1 + HeaderValue(header);
  131.  
  132.     /* Allocate it */
  133.     old = (lispobj *)PTR(thing);
  134.     new = static_free;
  135.     static_free += CEILING(nwords, 2);
  136.  
  137.     /* Copy it. */
  138.     bcopy(old, new, nwords * sizeof(lispobj));
  139.  
  140.     /* Deposit forwarding pointer. */
  141.     result = (lispobj)new | LowtagOf(thing);
  142.     *old = result;
  143.         
  144.     /* Scavenge the function. */
  145.     sym = (struct symbol *)new;
  146.     oldfn = sym->function;
  147.     pscav(&sym->function, 1, FALSE);
  148.     if ((char *)oldfn + RAW_ADDR_OFFSET == sym->raw_function_addr)
  149.         sym->raw_function_addr = (char *)sym->function + RAW_ADDR_OFFSET;
  150.  
  151.     return result;
  152. }
  153.  
  154. static lispobj ptrans_unboxed(thing, header)
  155. {
  156.     int nwords;
  157.     lispobj result, *new, *old;
  158.  
  159.     nwords = 1 + HeaderValue(header);
  160.  
  161.     /* Allocate it */
  162.     old = (lispobj *)PTR(thing);
  163.     new = read_only_free;
  164.     read_only_free += CEILING(nwords, 2);
  165.  
  166.     /* Copy it. */
  167.     bcopy(old, new, nwords * sizeof(lispobj));
  168.  
  169.     /* Deposit forwarding pointer. */
  170.     result = (lispobj)new | LowtagOf(thing);
  171.     *old = result;
  172.  
  173.     return result;
  174. }
  175.  
  176. static lispobj ptrans_vector(thing, bits, extra, boxed, constant)
  177.      lispobj thing;
  178.      int bits, extra;
  179.      boolean boxed, constant;
  180. {
  181.     struct vector *vector;
  182.     int nwords;
  183.     lispobj result, *new;
  184.  
  185.     vector = (struct vector *)PTR(thing);
  186.     nwords = 2 + (CEILING((FIXNUM_TO_INT(vector->length)+extra)*bits,32)>>5);
  187.  
  188.     if (boxed && !constant) {
  189.         new = static_free;
  190.         static_free += CEILING(nwords, 2);
  191.     }
  192.     else {
  193.         new = read_only_free;
  194.         read_only_free += CEILING(nwords, 2);
  195.     }
  196.  
  197.     bcopy(vector, new, nwords * sizeof(lispobj));
  198.  
  199.     result = (lispobj)new | LowtagOf(thing);
  200.     vector->header = result;
  201.  
  202.     if (boxed)
  203.         pscav(new, nwords, constant);
  204.  
  205.     return result;
  206. }
  207.  
  208.  
  209. static lispobj ptrans_code(thing)
  210.      lispobj thing;
  211. {
  212.     struct code *code, *new;
  213.     int nwords;
  214.     lispobj func, result;
  215.  
  216.     code = (struct code *)PTR(thing);
  217.     nwords = HeaderValue(code->header) + FIXNUM_TO_INT(code->code_size);
  218.  
  219.     new = (struct code *)read_only_free;
  220.     read_only_free += CEILING(nwords, 2);
  221.  
  222.     bcopy(code, new, nwords * sizeof(lispobj));
  223.     
  224.     result = (lispobj)new | type_OtherPointer;
  225.  
  226.     /* Stick in a forwarding pointer for the code object. */
  227.     *(lispobj *)code = result;
  228.  
  229.     /* Put in forwarding pointers for all the functions. */
  230.     for (func = code->entry_points;
  231.          func != NIL;
  232.          func = ((struct function_header *)PTR(func))->next) {
  233.  
  234.         gc_assert(LowtagOf(func) == type_FunctionPointer);
  235.  
  236.         *(lispobj *)PTR(func) = result + (func - thing);
  237.     }
  238.  
  239.     /* Arrange to scavenge the debug info later. */
  240.     pscav_later(&new->debug_info, 1);
  241.  
  242.     /* Scavenge the constants. */
  243.     pscav(new->constants, HeaderValue(new->header)-5, TRUE);
  244.  
  245.     /* Scavenge all the functions. */
  246.     pscav(&new->entry_points, 1, TRUE);
  247.     for (func = new->entry_points;
  248.          func != NIL;
  249.          func = ((struct function_header *)PTR(func))->next) {
  250.         gc_assert(LowtagOf(func) == type_FunctionPointer);
  251.         gc_assert(!dynamic_pointer_p(func));
  252.         pscav(&((struct function_header *)PTR(func))->self, 2, TRUE);
  253.         pscav_later(&((struct function_header *)PTR(func))->name, 3);
  254.     }
  255.  
  256.     return result;
  257. }
  258.  
  259. static lispobj ptrans_func(thing, header, constant)
  260.      lispobj thing, header;
  261.      boolean constant;
  262. {
  263.     int nwords;
  264.     lispobj code, *new, *old, result;
  265.     struct function_header *function;
  266.  
  267.     /* THING can either be a function header, a closure function header, */
  268.     /* a closure, or a funcallable-instance.  If it's a closure or a */
  269.     /* funcallable-instance, we do the same as ptrans_boxed. */
  270.     /* Otherwise we have to do something strange, 'cause it is buried inside */
  271.     /* a code object. */
  272.  
  273.     if (TypeOf(header) == type_ClosureHeader) {
  274.         nwords = 1 + HeaderValue(header);
  275.  
  276.         /* Allocate it.  Closures can always go in read-only space, 'caues */
  277.         /* they never change. */
  278.         old = (lispobj *)PTR(thing);
  279.         new = read_only_free;
  280.         read_only_free += CEILING(nwords, 2);
  281.  
  282.         /* Copy it. */
  283.         bcopy(old, new, nwords * sizeof(lispobj));
  284.  
  285.         /* Deposit forwarding pointer. */
  286.         result = (lispobj)new | LowtagOf(thing);
  287.         *old = result;
  288.  
  289.         /* Scavenge it. */
  290.         pscav(new, nwords, constant);
  291.  
  292.         return result;
  293.     }
  294.     else if (TypeOf(header) == type_FuncallableInstanceHeader) {
  295.         nwords = 1 + HeaderValue(header);
  296.  
  297.         /* Allocate it.  It *must* not go in read_only space. */
  298.         old = (lispobj *)PTR(thing);
  299.         new = static_free;
  300.         static_free += CEILING(nwords, 2);
  301.  
  302.         /* Copy it. */
  303.         bcopy(old, new, nwords * sizeof(lispobj));
  304.  
  305.         /* Deposit forwarding pointer. */
  306.         result = (lispobj)new | LowtagOf(thing);
  307.         *old = result;
  308.  
  309.         /* Scavenge it. */
  310.         pscav(new, nwords, constant);
  311.  
  312.         return result;
  313.     }
  314.     else {
  315.         gc_assert(TypeOf(header) == type_FunctionHeader ||
  316.                   TypeOf(header) == type_ClosureFunctionHeader);
  317.  
  318.         /* We can only end up here if the code object has not been */
  319.         /* scavenged, because if it had been scavenged, forwarding pointers */
  320.         /* would have been left behind for all the entry points. */
  321.  
  322.         function = (struct function_header *)PTR(thing);
  323.         code = PTR(thing) - (HeaderValue(function->header) * sizeof(lispobj)) |
  324.             type_OtherPointer;
  325.  
  326.         /* This will cause the function's header to be replaced with a */
  327.         /* forwarding pointer. */
  328.         ptrans_code(code);
  329.  
  330.         /* So we can just return that. */
  331.         return function->header;
  332.     }
  333. }
  334.  
  335. static lispobj ptrans_returnpc(thing, header)
  336.      lispobj thing, header;
  337. {
  338.     lispobj code, new;
  339.  
  340.     /* Find the corresponding code object. */
  341.     code = thing - HeaderValue(header)*sizeof(lispobj);
  342.  
  343.     /* Make sure it's been transported. */
  344.     new = *(lispobj *)PTR(code);
  345.     if (!forwarding_pointer_p(new))
  346.         new = ptrans_code(code);
  347.  
  348.     /* Maintain the offset: */
  349.     return new + (thing - code);
  350. }
  351.  
  352. #define WORDS_PER_CONS CEILING(sizeof(struct cons) / sizeof(lispobj), 2)
  353.  
  354. static lispobj ptrans_list(thing, constant)
  355.      lispobj thing;
  356.      boolean constant;
  357. {
  358.     struct cons *old, *new, *orig;
  359.     int length;
  360.  
  361.     if (constant)
  362.         orig = (struct cons *)read_only_free;
  363.     else
  364.         orig = (struct cons *)static_free;
  365.     length = 0;
  366.  
  367.     do {
  368.         /* Allocate a new cons cell. */
  369.         old = (struct cons *)PTR(thing);
  370.         if (constant) {
  371.             new = (struct cons *)read_only_free;
  372.             read_only_free += WORDS_PER_CONS;
  373.         }
  374.         else {
  375.             new = (struct cons *)static_free;
  376.             static_free += WORDS_PER_CONS;
  377.         }
  378.  
  379.         /* Copy the cons cell and keep a pointer to the cdr. */
  380.         new->car = old->car;
  381.         thing = new->cdr = old->cdr;
  382.  
  383.         /* Set up the forwarding pointer. */
  384.         *(lispobj *)old = ((lispobj)new) | type_ListPointer;
  385.  
  386.         /* And count this cell. */
  387.         length++;
  388.     } while (LowtagOf(thing) == type_ListPointer &&
  389.              dynamic_pointer_p(thing) &&
  390.              !(forwarding_pointer_p(*(lispobj *)PTR(thing))));
  391.  
  392.     /* Scavenge the list we just copied. */
  393.     pscav(orig, length * WORDS_PER_CONS, constant);
  394.  
  395.     return ((lispobj)orig) | type_ListPointer;
  396. }
  397.  
  398. static lispobj ptrans_otherptr(thing, header, constant)
  399.      lispobj thing, header;
  400.      boolean constant;
  401. {
  402.     switch (TypeOf(header)) {
  403.       case type_Bignum:
  404.       case type_SingleFloat:
  405.       case type_DoubleFloat:
  406.       case type_Sap:
  407.         return ptrans_unboxed(thing, header);
  408.  
  409.       case type_Ratio:
  410.       case type_Complex:
  411.       case type_SimpleArray:
  412.       case type_ComplexString:
  413.       case type_ComplexVector:
  414.       case type_ComplexArray:
  415.       case type_ClosureHeader:
  416.         return ptrans_boxed(thing, header, constant);
  417.  
  418.       case type_FuncallableInstanceHeader:
  419.       case type_ValueCellHeader:
  420.       case type_WeakPointer:
  421.         return ptrans_boxed(thing, header, FALSE);
  422.  
  423.       case type_SymbolHeader:
  424.         return ptrans_symbol(thing, header);
  425.  
  426.       case type_SimpleString:
  427.         return ptrans_vector(thing, 8, 1, FALSE, constant);
  428.  
  429.       case type_SimpleBitVector:
  430.         return ptrans_vector(thing, 1, 0, FALSE, constant);
  431.  
  432.       case type_SimpleVector:
  433.         return ptrans_vector(thing, 32, 0, TRUE, constant);
  434.  
  435.       case type_SimpleArrayUnsignedByte2:
  436.         return ptrans_vector(thing, 2, 0, FALSE, constant);
  437.  
  438.       case type_SimpleArrayUnsignedByte4:
  439.         return ptrans_vector(thing, 4, 0, FALSE, constant);
  440.  
  441.       case type_SimpleArrayUnsignedByte8:
  442.         return ptrans_vector(thing, 8, 0, FALSE, constant);
  443.  
  444.       case type_SimpleArrayUnsignedByte16:
  445.         return ptrans_vector(thing, 16, 0, FALSE, constant);
  446.  
  447.       case type_SimpleArrayUnsignedByte32:
  448.         return ptrans_vector(thing, 32, 0, FALSE, constant);
  449.  
  450.       case type_SimpleArraySingleFloat:
  451.         return ptrans_vector(thing, 32, 0, FALSE, constant);
  452.  
  453.       case type_SimpleArrayDoubleFloat:
  454.         return ptrans_vector(thing, 64, 0, FALSE, constant);
  455.  
  456.       case type_CodeHeader:
  457.         return ptrans_code(thing);
  458.  
  459.       case type_ReturnPcHeader:
  460.         return ptrans_returnpc(thing, header);
  461.  
  462.       default:
  463.         /* Should only come across other pointers to the above stuff. */
  464.         gc_abort();
  465.     }
  466. }
  467.  
  468. static int pscav_symbol(symbol)
  469.      struct symbol *symbol;
  470. {
  471.     boolean fix_func;
  472.  
  473.     fix_func = ((char *)(symbol->function + RAW_ADDR_OFFSET) ==
  474.                 symbol->raw_function_addr);
  475.     pscav(&symbol->value, sizeof(struct symbol)/sizeof(lispobj) - 1, FALSE);
  476.     if (fix_func)
  477.         symbol->raw_function_addr =
  478.             (char *)(symbol->function + RAW_ADDR_OFFSET);
  479.     return sizeof(struct symbol) / sizeof(lispobj);
  480. }
  481.  
  482. #if 0
  483. static int pscav_code(addr)
  484.      lispobj *addr;
  485. {
  486.     struct code *code;
  487.  
  488.     code = (struct code *)addr;
  489.  
  490.     pscav_later(&code->debug_info, 1);
  491.     pscav(code->constants, HeaderValue(code->header)-4, TRUE);
  492.  
  493.     return HeaderValue(code->header) + FIXNUM_TO_INT(code->code_size);
  494. }    
  495. #endif
  496.  
  497. static lispobj *pscav(addr, nwords, constant)
  498.      lispobj *addr;
  499.      int nwords;
  500.      boolean constant;
  501. {
  502.     lispobj thing, *thingp, header;
  503.     int count;
  504.     struct vector *vector;
  505.  
  506.     while (nwords > 0) {
  507.         thing = *addr;
  508.         if (Pointerp(thing)) {
  509.             /* It's a pointer.  Is it something we might have to move? */
  510.             if (dynamic_pointer_p(thing)) {
  511.                 /* Maybe.  Have we already moved it? */
  512.                 thingp = (lispobj *)PTR(thing);
  513.                 header = *thingp;
  514.                 if (Pointerp(header) && forwarding_pointer_p(header))
  515.                     /* Yep, so just copy the forwarding pointer. */
  516.                     thing = header;
  517.                 else {
  518.                     /* Nope, copy the object. */
  519.                     switch (LowtagOf(thing)) {
  520.                       case type_FunctionPointer:
  521.                         thing = ptrans_func(thing, header, constant);
  522.                         break;
  523.                     
  524.                       case type_ListPointer:
  525.                         thing = ptrans_list(thing, constant);
  526.                         break;
  527.                     
  528.                       case type_StructurePointer:
  529.                         thing = ptrans_boxed(thing, header, constant);
  530.                         break;
  531.                     
  532.                       case type_OtherPointer:
  533.                         thing = ptrans_otherptr(thing, header, constant);
  534.                         break;
  535.  
  536.                       default:
  537.                         /* It was a pointer, but not one of them? */
  538.                         gc_abort();
  539.                     }
  540.                 }
  541.                 *addr = thing;
  542.             }
  543.             count = 1;
  544.         }
  545.         else if (thing & 3) {
  546.             /* It's an other immediate.  Maybe the header for an unboxed */
  547.             /* object. */
  548.             switch (TypeOf(thing)) {
  549.               case type_Bignum:
  550.               case type_SingleFloat:
  551.               case type_DoubleFloat:
  552.               case type_Sap:
  553.                 /* It's an unboxed simple object. */
  554.                 count = HeaderValue(thing)+1;
  555.                 break;
  556.  
  557.               case type_SymbolHeader:
  558.                 /* Symbols must have the raw function addr fixed up. */
  559.                 count = pscav_symbol((struct symbol *)addr);
  560.                 break;
  561.  
  562.               case type_SimpleVector:
  563.                 if (HeaderValue(thing) == subtype_VectorValidHashing)
  564.                     *addr = (subtype_VectorMustRehash<<type_Bits) |
  565.                         type_SimpleVector;
  566.                 count = 1;
  567.                 break;
  568.  
  569.               case type_SimpleString:
  570.                 vector = (struct vector *)addr;
  571.                 count = CEILING(NWORDS(FIXNUM_TO_INT(vector->length)+1,4)+2,2);
  572.                 break;
  573.  
  574.               case type_SimpleBitVector:
  575.                 vector = (struct vector *)addr;
  576.                 count = CEILING(NWORDS(FIXNUM_TO_INT(vector->length),32)+2,2);
  577.                 break;
  578.  
  579.               case type_SimpleArrayUnsignedByte2:
  580.                 vector = (struct vector *)addr;
  581.                 count = CEILING(NWORDS(FIXNUM_TO_INT(vector->length),16)+2,2);
  582.                 break;
  583.  
  584.               case type_SimpleArrayUnsignedByte4:
  585.                 vector = (struct vector *)addr;
  586.                 count = CEILING(NWORDS(FIXNUM_TO_INT(vector->length),8)+2,2);
  587.                 break;
  588.  
  589.               case type_SimpleArrayUnsignedByte8:
  590.                 vector = (struct vector *)addr;
  591.                 count = CEILING(NWORDS(FIXNUM_TO_INT(vector->length),4)+2,2);
  592.                 break;
  593.  
  594.               case type_SimpleArrayUnsignedByte16:
  595.                 vector = (struct vector *)addr;
  596.                 count = CEILING(NWORDS(FIXNUM_TO_INT(vector->length),2)+2,2);
  597.                 break;
  598.  
  599.               case type_SimpleArrayUnsignedByte32:
  600.                 vector = (struct vector *)addr;
  601.                 count = CEILING(FIXNUM_TO_INT(vector->length)+2,2);
  602.                 break;
  603.  
  604.               case type_SimpleArraySingleFloat:
  605.                 vector = (struct vector *)addr;
  606.                 count = CEILING(FIXNUM_TO_INT(vector->length)+2,2);
  607.                 break;
  608.  
  609.               case type_SimpleArrayDoubleFloat:
  610.                 vector = (struct vector *)addr;
  611.                 count = FIXNUM_TO_INT(vector->length)*2+2;
  612.                 break;
  613.  
  614.               case type_CodeHeader:
  615.                 gc_abort(); /* No code headers in static space */
  616.                 break;
  617.  
  618.               case type_FunctionHeader:
  619.               case type_ClosureFunctionHeader:
  620.               case type_ReturnPcHeader:
  621.                 /* We should never hit any of these, 'cause they occure */
  622.                 /* buried in the middle of code objects. */
  623.                 gc_abort();
  624.  
  625.               case type_WeakPointer:
  626.                 /* Weak pointers get preserved during purify, 'cause I don't */
  627.                 /* feel like figuring out how to break them. */
  628.                 pscav(addr+1, 2, constant);
  629.                 count = 4;
  630.                 break;
  631.  
  632.               default:
  633.                 count = 1;
  634.                 break;
  635.             }
  636.         }
  637.         else {
  638.             /* It's a fixnum. */
  639.             count = 1;
  640.         }
  641.             
  642.         addr += count;
  643.         nwords -= count;
  644.     }
  645.  
  646.     return addr;
  647. }
  648.  
  649.  
  650. int purify(static_roots, read_only_roots)
  651. lispobj static_roots, read_only_roots;
  652. {
  653.     lispobj *clean;
  654.     int count, i;
  655.     struct later *laters, *next;
  656.  
  657. #ifdef PRINTNOISE
  658.     printf("[Doing purification:");
  659.     fflush(stdout);
  660. #endif
  661.  
  662.     if (FIXNUM_TO_INT(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)) != 0) {
  663.         printf(" Ack! Can't purify interrupt contexts. ");
  664.         fflush(stdout);
  665.         return;
  666.     }
  667.  
  668.     read_only_end = read_only_free =
  669.         (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER);
  670.     static_end = static_free =
  671.         (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER);
  672.  
  673. #ifdef PRINTNOISE
  674.     printf(" roots");
  675.     fflush(stdout);
  676. #endif
  677.     pscav(&static_roots, 1, FALSE);
  678.     pscav(&read_only_roots, 1, TRUE);
  679.  
  680. #ifdef PRINTNOISE
  681.     printf(" handlers");
  682.     fflush(stdout);
  683. #endif
  684.     pscav((lispobj *) interrupt_handlers,
  685.           sizeof(interrupt_handlers) / sizeof(lispobj),
  686.           FALSE);
  687.  
  688. #ifdef PRINTNOISE
  689.     printf(" stack");
  690.     fflush(stdout);
  691. #endif
  692.     pscav(control_stack, current_control_stack_pointer - control_stack, FALSE);
  693.  
  694. #ifdef PRINTNOISE
  695.     printf(" bindings");
  696.     fflush(stdout);
  697. #endif
  698. #ifndef ibmrt
  699.     pscav(binding_stack, current_binding_stack_pointer - binding_stack, FALSE);
  700. #else
  701.     pscav(binding_stack, (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack, FALSE);
  702. #endif
  703.  
  704. #ifdef PRINTNOISE
  705.     printf(" static");
  706.     fflush(stdout);
  707. #endif
  708.     clean = static_space;
  709.     do {
  710.         while (clean != static_free)
  711.             clean = pscav(clean, static_free - clean, FALSE);
  712.         laters = later_blocks;
  713.         count = later_count;
  714.         later_blocks = NULL;
  715.         later_count = 0;
  716.         while (laters != NULL) {
  717.             for (i = 0; i < count; i++) {
  718.                 if (laters->u[i].count == 0)
  719.                     ;
  720.                 else if (laters->u[i].count <= LATERMAXCOUNT) {
  721.                     pscav(laters->u[i+1].ptr, laters->u[i].count, TRUE);
  722.                     i++;
  723.                 }
  724.                 else
  725.                     pscav(laters->u[i].ptr, 1, TRUE);
  726.             }
  727.             next = laters->next;
  728.             free(laters);
  729.             laters = next;
  730.             count = LATERBLOCKSIZE;
  731.         }
  732.     } while (clean != static_free || later_blocks != NULL);
  733.  
  734.  
  735. #ifdef PRINTNOISE
  736.     printf(" cleanup");
  737.     fflush(stdout);
  738. #endif
  739.     os_zero((os_vm_address_t) current_dynamic_space,
  740.             (os_vm_size_t) DYNAMIC_SPACE_SIZE);
  741.  
  742.     /* Zero stack. */
  743.     os_zero((os_vm_address_t) current_control_stack_pointer,
  744.             (os_vm_size_t) (CONTROL_STACK_SIZE -
  745.                             ((current_control_stack_pointer - control_stack) *
  746.                              sizeof(lispobj))));
  747.  
  748. #ifndef ibmrt
  749.     current_dynamic_space_free_pointer = current_dynamic_space;
  750. #else
  751.     SetSymbolValue(ALLOCATION_POINTER, (lispobj)current_dynamic_space);
  752. #endif
  753.     SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free);
  754.     SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free);
  755.  
  756. #ifdef PRINTNOISE
  757.     printf(" Done.]\n");
  758.     fflush(stdout);
  759. #endif
  760.  
  761.     return 0;
  762. }
  763.